home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / w3 / w3-e19.el < prev    next >
Encoding:
Text File  |  1995-08-31  |  30.8 KB  |  901 lines
  1. ;;; w3-e19.el,v --- Emacs 19.xx specific functions for emacs-w3
  2. ;; Author: wmperry
  3. ;; Created: 1995/08/30 20:33:17
  4. ;; Version: 1.126
  5. ;; Keywords: faces, help, mouse, hypermedia
  6.  
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.com)
  9. ;;;
  10. ;;; This file is part of GNU Emacs.
  11. ;;;
  12. ;;; GNU Emacs is free software; you can redistribute it and/or modify
  13. ;;; it under the terms of the GNU General Public License as published by
  14. ;;; the Free Software Foundation; either version 2, or (at your option)
  15. ;;; any later version.
  16. ;;;
  17. ;;; GNU Emacs is distributed in the hope that it will be useful,
  18. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20. ;;; GNU General Public License for more details.
  21. ;;;
  22. ;;; You should have received a copy of the GNU General Public License
  23. ;;; along with GNU Emacs; see the file COPYING.  If not, write to
  24. ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  25. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26.  
  27. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28. ;;; Enhancements For Emacs 19
  29. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30.  
  31. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  32. ;;; Help menu
  33. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  34. (defvar w3-e19-popup-menu nil
  35.   "A menu for button3.")
  36.  
  37. (defvar w3-air-hotlists nil
  38.   "*A list of AIR-Mosaic hotlists to put in the menubar.")
  39.  
  40. (defvar menu-bar-w3-help-menu (if (boundp 'menu-bar-help-menu)
  41.                   (copy-keymap menu-bar-help-menu)
  42.                 nil)
  43.   "*A copy of the help menu so W3 can add its own items.")
  44.  
  45. (defvar w3-html-faq
  46.   "http://www.ncsa.uiuc.edu/General/Internet/WWW/HTMLPrimer.html"
  47.   "*The location of the HTML FAQ to put in the help menu.")
  48.  
  49. (defvar w3-url-faq "http://www.ncsa.uiuc.edu/demoweb/url-primer.html"
  50.   "*The location of the URL FAQ to put in the help menu.")
  51.  
  52. (defvar w3-mode-file-menu nil)
  53. (defvar w3-air-hotlist-menu nil)
  54. (defvar w3-mode-go-menu nil)
  55. (defvar w3-print-menu nil)
  56. (defvar w3-mail-menu nil)
  57. (defvar w3-hotlist-menu nil)
  58.  
  59. (defun w3-e19-setup-menus ()
  60.   ;; Setup base menus for emacs 19
  61.   (add-hook 'menu-bar-final-items 'w3help)
  62.   (add-hook 'menu-bar-final-items 'hotlist)
  63.   (define-key w3-mode-map [menu-bar help] 'undefined)
  64.   ;; Emacs 19.29 and later use help-menu as the keyname
  65.   (define-key w3-mode-map [menu-bar help-menu] 'undefined)
  66.   (define-key w3-mode-map [menu-bar w3help] (cons "Help"
  67.                           menu-bar-w3-help-menu))
  68.  
  69.   (let ((cntr 0))
  70.     (mapcar
  71.      (function
  72.       (lambda (dat)
  73.     (setq cntr (1+ cntr))
  74.     (if (stringp dat)
  75.         (setq dat (cons "" 'ignore)))
  76.     (define-key menu-bar-w3-help-menu
  77.       (vector (intern (concat "w3" (int-to-string cntr))))
  78.       dat)))
  79.      (nreverse
  80.       (list
  81.        (cons "About W3" (function
  82.              (lambda ()
  83.                (interactive)
  84.                (w3-fetch "about:"))))
  85.        (cons "W3 Manual"
  86.          (list 'lambda () '(interactive)
  87.            (list 'w3-fetch (concat w3-documentation-root
  88.                        "docs/w3_toc.html"))))
  89.        "---"
  90.        (cons (concat "Help on v" w3-version-number)
  91.          (list 'lambda () '(interactive)
  92.            (list 'w3-fetch (concat w3-documentation-root
  93.                        "help_on_" 
  94.                        w3-version-number ".html"))))
  95.        (cons "On Window" (list 'lambda () '(interactive)
  96.                    (list 'w3-fetch
  97.                      (concat w3-documentation-root
  98.                          "window-help.html"))))
  99.        (cons "On FAQ" (list 'lambda () '(interactive)
  100.                 (list 'w3-fetch (concat w3-documentation-root
  101.                             "FAQ.html"))))
  102.        "---"
  103.        (cons "On HTML" '(lambda () (interactive) (w3-fetch w3-html-faq)))
  104.        (cons "On URLs" '(lambda () (interactive) (w3-fetch w3-url-faq)))
  105.        (cons "Submit W3 Bug" 'w3-submit-bug)
  106.        (cons "--" 'ignore)))))
  107.   
  108.   (setq w3-e19-popup-menu (make-sparse-keymap "WWW"))
  109.   (define-key w3-e19-popup-menu [kill] (cons "Leave & kill buffer"
  110.                          'w3-quit))
  111.   (define-key w3-e19-popup-menu [leave] (cons "Leave & bury buffer"
  112.                           'w3-leave-buffer))
  113.   (define-key w3-e19-popup-menu [sep0] (cons "----" 'ignore))
  114.   (define-key w3-e19-popup-menu [anno] (cons "Add annotation"
  115.                          'w3-annotation-add))
  116.   (define-key w3-e19-popup-menu [sep1] (cons "----" 'ignore))
  117.   (define-key w3-e19-popup-menu [sep2] (cons "----" 'ignore))
  118.   (define-key w3-e19-popup-menu [copyurl] (cons "Copy URL to clipboard"
  119.                         'w3-save-url))
  120.   (define-key w3-e19-popup-menu [url] (cons "Open URL" 'w3-fetch))
  121.   (define-key w3-e19-popup-menu [file] (cons "Open file" 'w3-open-local))
  122.  
  123.   (define-key w3-mode-map [menu-bar view]
  124.     (cons "View" (make-sparse-keymap "View")))
  125.   (if (fboundp 'w3-show-graphics)
  126.       (define-key w3-mode-map [menu-bar view show-graphics]
  127.     (cons "Show Graphics" 'w3-show-graphics)))
  128.   (define-key w3-mode-map [menu-bar view reload]
  129.     (cons "Reload" 'w3-reload-document))
  130.   (define-key w3-mode-map [menu-bar view refresh]
  131.     (cons "Refresh" 'w3-refresh-buffer))
  132.   (define-key w3-mode-map [menu-bar view separator]
  133.     (cons "----" 'ignore))
  134.   (define-key w3-mode-map [menu-bar view source]
  135.     (cons "Document Source" 'w3-source-document))
  136.   (define-key w3-mode-map [menu-bar view info]
  137.     (cons "Document Information" 'w3-document-information))
  138.  
  139.   (setq w3-mode-go-menu (make-sparse-keymap "Go"))
  140.   (define-key w3-mode-go-menu [links] (cons "Links..."
  141.                         'w3-e19-show-links-menu))
  142.   (define-key w3-mode-go-menu [go-sep1] '("--"))
  143.   (define-key w3-mode-go-menu [go-hist4] 'undefined)
  144.   (define-key w3-mode-go-menu [go-hist3] 'undefined)
  145.   (define-key w3-mode-go-menu [go-hist2] 'undefined)
  146.   (define-key w3-mode-go-menu [go-hist1] 'undefined)
  147.   (define-key w3-mode-go-menu [go-hist0] 'undefined)
  148.   (define-key w3-mode-go-menu [go-sep0] '("--"))
  149.   (define-key w3-mode-go-menu [history]
  150.     (cons "View History" 'w3-show-history-list))
  151.   (define-key w3-mode-go-menu [go-sep1]
  152.     '("--"))
  153.   (define-key w3-mode-go-menu [home]
  154.     (cons "Home" 'w3))
  155.   (define-key w3-mode-go-menu [back]
  156.     (cons "Back" 'w3-backward-in-history))
  157.   (define-key w3-mode-go-menu [forw]
  158.     (cons "Forward" 'w3-forward-in-history))
  159.  
  160.   (setq w3-mail-menu (make-sparse-keymap "Mail"))
  161.   (define-key w3-mail-menu [latex]
  162.     '("LaTeX Source" . (lambda ()
  163.             (interactive)
  164.             (w3-mail-current-document nil "LaTeX Source"))))
  165.   (define-key w3-mail-menu [postscript]
  166.     '("PostScript" . (lambda ()
  167.                (interactive)
  168.                (w3-mail-current-document nil "PostScript"))))
  169.   (define-key w3-mail-menu [text]
  170.     '("Formatted Text" . (lambda ()
  171.                (interactive)
  172.                (w3-mail-current-document nil "Formatted Text"))))
  173.   (define-key w3-mail-menu [html]
  174.     '("HTML Source" . (lambda ()
  175.             (interactive)
  176.             (w3-mail-current-document nil "HTML Source"))))
  177.  
  178.   (setq w3-print-menu (make-sparse-keymap "Print"))
  179.   (define-key w3-print-menu [latex]
  180.     '("LaTeX'd" . (lambda ()
  181.             (interactive)
  182.             (w3-print-this-url nil "LaTeX'd"))))
  183.   (define-key w3-print-menu [postscript]
  184.     '("PostScript" . (lambda ()
  185.                (interactive)
  186.                (w3-print-this-url nil "PostScript"))))
  187.   (define-key w3-print-menu [text]
  188.     '("Formatted Text" . (lambda ()
  189.                (interactive)
  190.                (w3-print-this-url nil "Formatted Text"))))
  191.   (define-key w3-print-menu [html]
  192.     '("HTML Source" . (lambda ()
  193.             (interactive)
  194.             (w3-print-this-url nil "HTML Source"))))
  195.   ;; Disable some file menu items
  196.   (define-key w3-mode-map [menu-bar file] 'undefined)
  197.   (define-key w3-mode-map [menu-bar files] 'undefined)
  198.   (setq w3-mode-file-menu (make-sparse-keymap "File"))
  199.   (define-key w3-mode-file-menu [die]
  200.     (cons "Exit Emacs" 'save-buffers-kill-emacs))
  201.   (define-key w3-mode-file-menu [separator-exit]
  202.     '("--"))
  203.   (define-key w3-mode-file-menu [quit]
  204.     (cons "Kill Buffer" 'w3-quit))
  205.   (define-key w3-mode-file-menu [leave]
  206.     (cons "Leave Buffer" 'w3-leave-buffer))
  207.   (define-key w3-mode-file-menu [separator-misc]
  208.     '("--"))
  209.   (define-key w3-mode-file-menu [mail]
  210.     (cons "Mail Document..." w3-mail-menu))
  211.   (define-key w3-mode-file-menu [print-buffer]
  212.     (cons "Print..." w3-print-menu))
  213.   (define-key w3-mode-file-menu [annotate]
  214.     (cons "Add Annotation" 'w3-annotation-add))
  215.   (define-key w3-mode-file-menu [separator-frames]
  216.     '("--"))
  217.   (define-key w3-mode-file-menu [delete-frame]
  218.     '("Delete Frame" . delete-frame))
  219.   (define-key w3-mode-file-menu [make-frame]
  220.     '("Make New Frame" . make-frame))
  221.   (define-key w3-mode-file-menu [separator-buffers]
  222.     '("--"))
  223.   (define-key w3-mode-file-menu [bookmark]
  224.     '("Bookmarks" . menu-bar-bookmark-map))
  225.   (define-key w3-mode-file-menu [write-file]
  226.     '("Save Buffer As..." . write-file))
  227.   (define-key w3-mode-file-menu [open-local]
  228.     (cons "Open File" 'w3-open-local))
  229.   (define-key w3-mode-file-menu [open-url]
  230.     (cons "Open URL" 'w3-fetch))
  231.   (setq w3-hotlist-menu (make-sparse-keymap "Hotlist"))
  232.   (define-key w3-hotlist-menu [pull]
  233.     (cons "Hotlist..." 'w3-e19-show-hotlist-menu))
  234.   (define-key w3-hotlist-menu [sep1] '("--"))
  235.   (define-key w3-hotlist-menu [append]
  236.     (cons "Append new hotlist file" 'w3-hotlist-append))
  237.   (define-key w3-hotlist-menu [rename]
  238.     (cons "Rename item in hotlist" 'w3-hotlist-rename-entry))
  239.   (define-key w3-hotlist-menu [delete]
  240.     (cons "Delete item from hotlist" 'w3-hotlist-delete))
  241.   (define-key w3-hotlist-menu [add]
  242.     (cons "Add this document to hotlist" 'w3-hotlist-add-document))
  243.   (define-key w3-hotlist-menu [view]
  244.     (cons "View Hotlist..." 'w3-show-hotlist))
  245.   (define-key w3-mode-map [menu-bar hot]
  246.     (cons "Hotlist" w3-hotlist-menu))
  247.   (define-key w3-mode-map [menu-bar go]
  248.     (cons "Go" w3-mode-go-menu))
  249.   (define-key w3-mode-map [menu-bar options]
  250.     '("Options" . w3-e19-options-menu))
  251.   (define-key w3-mode-map [menu-bar w3file]
  252.     (cons "File" w3-mode-file-menu)))
  253.   
  254. (defun w3-shuffle-history-menu ()
  255.   ;; Set up the history menu
  256.   (if (keymapp w3-mode-go-menu)
  257.       (let ((hist-size 4)
  258.         (key nil))
  259.     (while (>= hist-size 0)
  260.       (setq key (intern (concat "go-hist" (int-to-string hist-size))))
  261.       (if (nth hist-size url-history-list)
  262.           (define-key w3-mode-go-menu (vector key)
  263.         (cons (cdr (nth hist-size url-history-list))
  264.               (list 'lambda () '(interactive)
  265.                 (list 'w3-fetch
  266.                   (car (nth hist-size url-history-list))))))
  267.         (define-key w3-mode-go-menu (vector key) 'undefined))
  268.       (setq hist-size (1- hist-size))))
  269.     (w3-warn 'emacs19 "Something wrong! w3-mode-go-menu is not a keymap!")))
  270.  
  271. (defun w3-create-hotlist-menu (chunk)
  272.   ;; Create a hotlist menu as a native menu bar.  Returns a keymap
  273.   ;; representing CHUNK as a menu.  Called recursively as often as
  274.   ;; necessary.
  275.   (let ((keymap (make-sparse-keymap (car chunk)))
  276.     (ctr 0)
  277.     (ttl (car chunk)))
  278.     (setq chunk (cdr (cdr chunk)))
  279.     (while chunk
  280.       (cond
  281.        ((and (listp (car chunk))
  282.          (null (nth 1 (car chunk))))
  283.     (define-key keymap (vector (intern (concat "hot" (int-to-string ctr))))
  284.       (w3-create-hotlist-menu (car chunk))))
  285.        ((listp (car chunk))
  286.     (define-key keymap (vector (intern (concat "hot" (int-to-string ctr))))
  287.       (cons (nth 0 (car chunk))
  288.         (list 'lambda () '(interactive)
  289.               (list 'w3-fetch
  290.                 (nth 1 (car chunk)))))))
  291.        (t 'undefined))
  292.       (setq chunk (cdr chunk)
  293.         ctr (1+ ctr)))
  294.     (cons ttl keymap)))
  295.  
  296. (defun w3-initialize-hotlist-menu (&optional path)
  297.   (let ((tmp w3-air-hotlists)
  298.     (ctr 0)
  299.     (dat nil))
  300.     (setq w3-air-hotlist-menu (make-sparse-keymap "Hotlists"))
  301.     (while tmp
  302.       (if (file-exists-p (car tmp))
  303.       (progn
  304.         (setq dat (w3-create-hotlist-menu (w3-parse-air-hotlist (car tmp)))
  305.           ctr (1+ ctr))
  306.         (if (listp dat)
  307.         (define-key w3-air-hotlist-menu
  308.           (vector (intern (concat "hot" (int-to-string ctr)))) dat))))
  309.       (setq tmp (cdr tmp)))))
  310.           
  311. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  312. ;;; Some hackery to get emacs19 to do bold/underline/etc
  313. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  314. ;;; Tips for creating a new w3-emacs19-hack-XXX function:
  315. ;;; use /etc/termcap, and look for these fields in the definition for your
  316. ;;; terminal:
  317. ;;; us = turn on underline
  318. ;;; ue = turn off underline
  319. ;;; md = bold
  320. ;;; se = normal
  321.  
  322. (defun w3-emacs19-hack-vt100 ()
  323.   ;; Hack 'faces' for ttys (vt100)
  324.   (or standard-display-table
  325.       (setq standard-display-table (make-vector 261 nil)))
  326.   (aset standard-display-table 1 (vector (create-glyph "\e[4m ")))
  327.   (aset standard-display-table 2 (vector (create-glyph "\e[m ")))
  328.   (aset standard-display-table 3 (vector (create-glyph "\e[1m ")))
  329.   (aset standard-display-table 4 (vector (create-glyph "\e[m ")))
  330.   )
  331.  
  332. (fset 'w3-emacs19-hack-vt102 'w3-emacs19-hack-vt100)
  333. (fset 'w3-emacs19-hack-vt200 'w3-emacs19-hack-vt100)
  334. (fset 'w3-emacs19-hack-vt220 'w3-emacs19-hack-vt100)
  335. (fset 'w3-emacs19-hack-vt300 'w3-emacs19-hack-vt100)
  336. (fset 'w3-emacs19-hack-vt320 'w3-emacs19-hack-vt100)
  337. (fset 'w3-emacs19-hack-xterms 'w3-emacs19-hack-xterm)
  338.  
  339. (defun w3-emacs19-hack-xterm ()
  340.   ;; Hack 'faces' for ttys (xterm)
  341.   (or standard-display-table
  342.       (setq standard-display-table (make-vector 261 nil)))
  343.   (aset standard-display-table 1 (vector (create-glyph "\e[4m ")))
  344.   (aset standard-display-table 2 (vector (create-glyph "\e[m ")))
  345.   (aset standard-display-table 3 (vector (create-glyph "\e[5m ")))
  346.   (aset standard-display-table 4 (vector (create-glyph "\e[m ")))
  347.   )
  348.  
  349. (defun w3-emacs19-hack-console ()
  350.   ;; Hack 'faces' for ttys (linux-console)
  351.   ;; This isn't exactly right, but close enough
  352.   (or standard-display-table
  353.       (setq standard-display-table (make-vector 261 nil)))
  354.   (aset standard-display-table 1 (vector (create-glyph "\e[1m ")))
  355.   (aset standard-display-table 2 (vector (create-glyph "\e[m ")))
  356.   (aset standard-display-table 3 (vector (create-glyph "\e[4m ")))
  357.   (aset standard-display-table 4 (vector (create-glyph "\e[m ")))
  358.   )
  359.  
  360. (defun w3-emacs19-unhack-faces ()
  361.   "Remove faces hacks in emacs 19"
  362.   (interactive)
  363.   (standard-display-default 1 4)
  364.   (setq w3-delimit-emphasis t
  365.     w3-delimit-links t))
  366.  
  367. (defvar w3-links-menu nil "Menu for w3-mode in emacs 19.")
  368. (make-variable-buffer-local 'w3-links-menu)
  369.  
  370. (defun w3-e19-options-menu (e)
  371.   (interactive "e")
  372.   (let ((val (x-popup-menu
  373.           e
  374.           (list
  375.            ""
  376.            (cons
  377.         ""
  378.         (mapcar (function
  379.              (lambda (x) (cons
  380.                       (concat 
  381.                        (if (and (boundp (car x))
  382.                         (symbol-value (car x)))
  383.                        "* "
  384.                      "  ")
  385.                        (cdr x)) (car x))))
  386.             '(
  387.               (w3-dump-to-disk          . "Download to disk")
  388.               (url-automatic-caching    . "Automatic Caching")
  389.               (url-standalone-mode      . "Rely solely on cache")
  390.               (ps-print-color-p         . "Color Printing")
  391.               (url-honor-refresh-requests . "Honor Automatic Refreshes")
  392.               (w3-user-colors-take-precedence .
  393.                               "Honor Color Requests")
  394.               (url-use-hypertext-gopher . "Hypertext Gopher")
  395.               (url-use-hypertext-dired  . "Hypertext Dired"))))))))
  396.     (cond
  397.      ((null val) nil)
  398.      (t (eval (list 'setq val (list 'not val)))))))
  399.  
  400. (defun w3-create-faces ()
  401.   ;; Create faces, the emacs 19 way
  402.   (if (and (memq (device-type)
  403.          '(x            ; X-windows?
  404.            ns            ; NeXTStep?
  405.            pm            ; OS/2?
  406.            win32        ; Windows NT?
  407.            ))
  408.        (fboundp 'make-face))
  409.       (progn
  410.     (make-face w3-node-style)
  411.     (make-face w3-visited-node-style)
  412.     (make-face w3-default-style)
  413.     (if (not (face-differs-from-default-p w3-visited-node-style))
  414.         (copy-face 'bold-italic w3-visited-node-style))
  415.     (if (not (face-differs-from-default-p w3-node-style))
  416.         (copy-face 'bold w3-node-style)))
  417.     (setq w3-default-style nil)))
  418.  
  419. (defun w3-add-hotlist-menu ()
  420.   ;; Add the hotlist menu to this buffer - used when it changes.
  421.   (let ((hot-menu (make-sparse-keymap "w3-hotlist"))
  422.     (ctr 0)
  423.     (hot w3-hotlist))
  424.     (while hot
  425.       (define-key hot-menu (vector (intern (concat "w3-hotlist-"
  426.                            (int-to-string ctr))))
  427.     (cons (car (car hot))
  428.           (list 'lambda () '(interactive)
  429.             (list 'w3-fetch (car (cdr (car hot)))))))
  430.       (setq ctr (1+ ctr)
  431.         hot (cdr hot)))
  432.     (setq w3-e19-hotlist-menu hot-menu)))
  433.  
  434. (defun w3-link-at (pt)
  435.   "Return the link(s) at point"
  436.   (get-text-property pt 'w3))
  437.  
  438. (defun w3-follow-mouse-other-frame (e)
  439.   "Function suitable to being bound to a mouse key.  Follows the link under
  440. the mouse click, opening it in another frame."
  441.   (interactive "e")
  442.   (mouse-set-point e)
  443.   (w3-follow-link-other-frame))
  444.  
  445. (defun w3-follow-mouse (e)
  446.   "Function suitable to being bound to a mouse key.  Follows the link under
  447. the mouse click."
  448.   (interactive "e")
  449.   (mouse-set-point e)
  450.   (w3-follow-link))
  451.  
  452. (defun w3-follow-inlined-image-mouse (e)
  453.   "Follow the inlined image under the mouse - ignore any hyperlinks or
  454. form entry areas and blindly try to find an image."
  455.   (interactive "e")
  456.   (mouse-set-point e)
  457.   (w3-follow-inlined-image))
  458.  
  459. (define-key w3-mode-map [mouse-2] 'w3-follow-mouse)
  460. (define-key w3-mode-map [down-mouse-3] 'w3-popup-menu)
  461. (define-key w3-mode-map [S-mouse-2] 'w3-follow-mouse-other-frame)
  462. (and (lookup-key global-map [mouse-movement])
  463.      (define-key w3-mode-map [mouse-movement] 'w3-mouse-handler))
  464.  
  465. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  466. ;;; Functions to build menus of urls
  467. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  468. (defun w3-e19-show-hotlist-menu (e)
  469.   (interactive "e")
  470.   (let* ((x (condition-case ()
  471.         (x-popup-menu e w3-e19-hotlist-menu)
  472.           (error nil)))        ; to trap for empty menus
  473.      (y (and x (lookup-key w3-e19-hotlist-menu (apply 'vector x)))))
  474.     (if (and x y)
  475.     (funcall y))))
  476.  
  477. (defun w3-e19-show-links-menu (e)
  478.   (interactive "e")
  479.   (let* ((x (condition-case ()
  480.         (x-popup-menu e w3-e19-links-menu)
  481.           (error nil)))        ; to trap for empty menus
  482.      (y (and x (lookup-key w3-e19-links-menu (apply 'vector x)))))
  483.     (if (and x y)
  484.     (funcall y))))
  485.  
  486. (defun w3-build-FSF19-menu ()
  487.   ;; Build emacs19 menus from w3-links-list
  488.   (let* ((ctr 0)
  489.      (menu-ctr 0)
  490.      (tmp nil)
  491.      (ovls (nreverse (w3-only-links)))
  492.      (menus nil))
  493.     (setq tmp (make-sparse-keymap "Links"))
  494.     (while ovls
  495.       (let ((data (w3-zone-data (car ovls))))
  496.     (if (and (eq (car-safe data) 'w3) (nth 2 data))
  497.         (progn
  498.           (if (> ctr w3-max-menu-length)
  499.           (setq menus (cons tmp menus)
  500.             ctr 0
  501.             tmp (make-sparse-keymap
  502.                  (concat "Links" (int-to-string
  503.                           (setq menu-ctr
  504.                             (1+ menu-ctr)))))))
  505.           (let ((ttl (w3-fix-spaces
  506.               (buffer-substring
  507.                (overlay-start (car ovls))
  508.                (overlay-end (car ovls)))))
  509.             (key (vector (intern (concat "link"
  510.                          (int-to-string
  511.                           (setq ctr (1+ ctr))))))))
  512.         (if (and (> (length ttl) 0) (nth 2 data))
  513.             (define-key tmp key 
  514.               (cons ttl
  515.                 (list 'lambda () '(interactive)
  516.                   (list 'w3-fetch (nth 2 data))))))))))
  517.       (setq ovls (cdr ovls)))
  518.     (if (not menus)
  519.     (setq w3-e19-links-menu tmp)
  520.       (setq w3-e19-links-menu (make-sparse-keymap "LinkMenu")
  521.         menus (nreverse (cons tmp menus))
  522.         ctr 0)
  523.       (while menus
  524.     (define-key w3-e19-links-menu
  525.       (vector (intern (concat "SubMenu" ctr)))
  526.       (cons "More..." (car menus)))
  527.     (setq menus (cdr menus)
  528.           ctr (1+ ctr))))))
  529.  
  530. (defun w3-popup-menu (e)
  531.   "Pop up a menu of common w3 commands"
  532.   (interactive "e")
  533.   (mouse-set-point e)
  534.   (let* ((ext (w3-zone-at (point)))
  535.      (dat (and ext (w3-zone-data ext)))
  536.      url val)
  537.     (cond
  538.      ((null dat)
  539.       (setq val (x-popup-menu e w3-e19-popup-menu)
  540.         val (and val (lookup-key w3-e19-popup-menu (apply 'vector val)))
  541.         val (and val (call-interactively val))
  542.         val nil))
  543.      ((eq (car dat) 'w3)        ; hyperlink
  544.       (setq val (x-popup-menu e (list "" (cons "" w3-hyperlink-menu)))
  545.         url (nth 2 dat)))
  546.      ((or (eq (car dat) 'w3graphic)
  547.       (eq (car dat) 'w3delayed))
  548.       (setq val (x-popup-menu e (list "" (cons "" w3-graphlink-menu)))
  549.         url (nth 1 dat)))
  550.      (t (setq val (x-popup-menu e w3-e19-popup-menu))))
  551.     (cond
  552.      ((and val (fboundp val) url)
  553.       (funcall val url))
  554.      ((and val (fboundp val))
  555.       (funcall val))
  556.      (t nil))))
  557.  
  558. (defun w3-setup-version-specifics ()
  559.   ;; Set up routine for emacs 19
  560.   (if (and (eq (device-type) 'tty) w3-emacs19-hack-faces-p)
  561.       (let ((hack-fn (intern (concat "w3-emacs19-hack-" (getenv "TERM")))))
  562.     (if (fboundp hack-fn)
  563.         (funcall hack-fn)
  564.       (url-warn 'emacs19
  565.             (format "Don't know how to hack faces for %s..."
  566.                 (getenv "TERM")))
  567.       (setq w3-emacs19-hack-faces-p nil))))
  568.   (if (not (memq (device-type)
  569.          '(x pm ns)))        ; Only load this up in X,
  570.                     ; presentation manager, or
  571.                     ; or NeXTstep, otherwise emacs
  572.                     ; will barf
  573.       nil
  574.     (if (boundp 'track-mouse)
  575.     (let ((x track-mouse))
  576.       (make-variable-buffer-local 'track-mouse)
  577.       (setq-default track-mouse x))))
  578.  
  579.   (if (boundp 'menu-bar-help-menu) (w3-e19-setup-menus))
  580.   (cond 
  581.    ((memq (device-type) '(x pm))
  582.     (fset 'w3-x-popup-menu 'x-popup-menu))
  583.    ((eq (device-type) 'ns)
  584.     (fset 'w3-x-popup-menu 'ns-popup-menu))))
  585.  
  586. (defun w3-store-in-x-clipboard (str)
  587.   "Store string STR in the Xwindows clipboard"
  588.   (cond
  589.    ((memq (device-type) '(x pm))
  590.     (x-set-selection 'PRIMARY str))
  591.    ((eq (device-type) 'ns) (ns-store-pasteboard-internal str))
  592.    (t nil)))
  593.  
  594. (defun w3-mode-version-specifics ()
  595.   ;; Emacs 19 specific stuff for w3-mode
  596.   (if (and (eq 'tty (device-type)) w3-emacs19-hack-faces-p)
  597.       (recenter 1))
  598.   (if w3-track-mouse (setq track-mouse t))
  599.   (if (or (memq (device-type) '(x pm ns)))
  600.       (w3-build-FSF19-menu)))
  601.  
  602. (defun w3-map-links (function &optional buffer from to maparg)
  603.   "Map FUNCTION over the hypertext links which overlap region in BUFFER,
  604. starting at FROM and ending at TO.  FUNCTION is called with the arguments
  605. linkdata, START, END, and MAPARG.
  606. The arguments FROM, TO, MAPARG, and BUFFER default to the beginning of
  607. BUFFER, the end of BUFFER, nil, and (current-buffer), respectively.
  608.  
  609. In emacs19, FROM, TO, and BUFFER are ignored.... working on it."
  610.   (mapcar (function (lambda (x)
  611.               (funcall function (w3-zone-data x)
  612.                    (overlay-start x) (overlay-end x) maparg)
  613.               nil)) (w3-only-links))
  614.   nil)
  615.  
  616. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  617. ;;; Alternate zone-functions for emacs 19.2x - these use overlays instead
  618. ;;; of text properties.  In emacs 19.22, text props cause lots of garbage
  619. ;;; collection.  Overlays don't appear to cause this problem.
  620. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  621. (fset 'w3-zone-start 'overlay-start)
  622. (fset 'w3-zone-end 'overlay-end)
  623. (fset 'w3-zone-eq 'eq)
  624. (fset 'w3-delete-zone 'delete-overlay)
  625. (fset 'w3-insert 'insert-before-markers)
  626.  
  627. (defun w3-fix-extent-endpoints ()
  628.   ;; Make sure no extents have whitespace/newlines at the end of them
  629.   (let ((ovls (overlay-lists)) st nd cur)
  630.     (setq ovls (nconc (car ovls) (cdr ovls)))
  631.     (while ovls
  632.       (setq cur (car ovls)
  633.         ovls (cdr ovls)
  634.         st (overlay-start cur)
  635.         nd (overlay-end cur))
  636.       (while (memq (char-after st) '(?  ?\n ?\t))
  637.     (setq st (1+ st)))
  638.       (move-overlay cur st nd))))
  639.  
  640. (defun w3-mouse-handler (e)
  641.   "Function to message the url under the mouse cursor"
  642.   (interactive "e")
  643.   (let* ((pt (posn-point (event-start e)))
  644.      (overlays (and pt (not (eq pt 'mode-line)) (overlays-at pt)))
  645.      (ovl nil)
  646.      (link nil) ;(nth 1 (nth 1 (memq 'w3 props))))
  647.      (form nil) ; (nth 1 (memq 'w3form props)))
  648.      (imag nil) ; (nth 1 (memq 'w3graphic props))))
  649.      )
  650.     (while overlays
  651.       (setq ovl (car overlays))
  652.       (cond
  653.        ((nth 1 (overlay-get ovl 'w3))
  654.     (setq link (nth 1 (overlay-get ovl 'w3))))
  655.        ((overlay-get ovl 'w3form)
  656.     (setq form (overlay-get ovl 'w3form)))
  657.        ((overlay-get ovl 'w3graphic)
  658.     (setq imag (overlay-get ovl 'w3graphic))))
  659.       (setq overlays (cdr overlays)))
  660.     (cond
  661.      (link (message "%s" link))
  662.      (form
  663.       (let ((args (nth 0 form)))
  664.     (cond
  665.      ((string= "SUBMIT" (nth 1 form))
  666.       (message "Submit form to %s" (cdr-safe (assoc "action" args))))
  667.      ((string= "RESET" (nth 1 form))
  668.       (message "Reset form contents"))
  669.      (t
  670.       (message "Form entry (name=%s, type=%s)" (nth 2 form)
  671.            (if (equal "" (nth 1 form))
  672.                "text"
  673.              (downcase (nth 1 form))))))))
  674.      (imag (message "Inlined image (%s)" (car imag)))
  675.      (t (message "")))))
  676.  
  677. (defun w3-zone-data (zone)
  678.   "Return the data from a zone"
  679.   (let ((link (overlay-get zone 'w3))
  680.     (form (overlay-get zone 'w3form))
  681.     (grph (overlay-get zone 'w3graphic))
  682.     (list (overlay-get zone 'w3expandlist)))
  683.     (cond
  684.      (link (cons 'w3 link))
  685.      (form (cons 'w3form form))
  686.      (grph (cons 'w3graphic grph))
  687.      (list (cons 'w3expandlist list))
  688.      (t nil))))
  689.   
  690. (defun w3-zone-at (pt)
  691.   "Return the extent at point PT that is either a link or a forms area."
  692.   (let ((ovls (overlays-at pt)) cur link form grph list)
  693.     (while ovls
  694.       (setq cur (car ovls)
  695.         ovls (cdr ovls)
  696.         link (or link (and (overlay-get cur 'w3) cur))
  697.         link (and link (nth 1 (overlay-get link 'w3)) link)
  698.         form (or form (and (overlay-get cur 'w3form) cur))
  699.         grph (or grph (and (overlay-get cur 'w3graphic) cur))
  700.         list (or list (and (overlay-get cur 'w3expandlist) cur))))
  701.     (cond
  702.      (link link)
  703.      (form form)
  704.      (grph grph)
  705.      (list list)
  706.      (t nil))))
  707.   
  708. (defun w3-only-links ()
  709.   "Get all the zones from a buffer"
  710.   (let ((ovls (overlay-lists)) cur result)
  711.     (setq ovls (nconc (car ovls) (cdr ovls)))
  712.     (while ovls
  713.       (setq cur (car ovls) ovls (cdr ovls))
  714.       (if (overlay-get cur 'w3) (setq result (cons cur result))))
  715.     (nreverse result)))
  716.   
  717. (defun w3-all-forms-zones ()
  718.   "Get all the zones from a buffer."
  719.   (let ((ovls (overlay-lists)) cur result)
  720.     (setq ovls (nconc (car ovls) (cdr ovls)))
  721.     (while ovls
  722.       (setq cur (car ovls) ovls (cdr ovls))
  723.       (if (overlay-get cur 'w3form) (setq result (cons cur result))))
  724.     (nreverse result)))
  725.   
  726. (defun w3-all-zones ()
  727.   "Get all the zones from a buffer."
  728.   (let ((ovls (overlay-lists)) cur result)
  729.     (setq ovls (nconc (car ovls) (cdr ovls)))
  730.     (while ovls
  731.       (setq cur (car ovls) ovls (cdr ovls))
  732.       (if (or (overlay-get cur 'w3) (overlay-get cur 'w3form))
  733.       (setq result (cons cur result))))
  734.     (nreverse result)))
  735.   
  736. (defun w3-find-specific-link (link)
  737.   "Find LINK in the current document"
  738.   (let ((ovls (overlay-lists))
  739.     cur found)
  740.     (setq ovls (nconc (car ovls) (cdr ovls)))
  741.     (while (and (not found) ovls)
  742.       (setq cur (car ovls) ovls (cdr ovls))
  743.       (if (equal link (overlay-get cur 'w3-ident))
  744.       (setq found (or (goto-char (overlay-start cur)) t))))
  745.     (if found
  746.     (let ((face (overlay-get cur 'face)))
  747.       (overlay-put cur 'face 'modeline)
  748.       (setq found nil)
  749.       (while (not (input-pending-p))
  750.         (sit-for 1))
  751.       (overlay-put cur 'face face)))))
  752.  
  753. (defun w3-back-link (p)
  754.   "Go back 1 link.  With prefix argument, go that many links."
  755.   (interactive "p")
  756.   (setq p (or p 1))
  757.   (if (< p 0)
  758.       (w3-forward-link (- p))
  759.     (let ((x (w3-zone-at (point))))
  760.       (and x (goto-char (w3-zone-start x))))
  761.     (let ((ovls (overlay-lists)) tmp cur)
  762.       (setq ovls (nconc (car ovls) (cdr ovls))
  763.         ovls (sort ovls
  764.                (function (lambda (x y)
  765.                    (< (overlay-start x) (overlay-start y))))))
  766.       (while (and ovls (< (overlay-start (car ovls)) (point)))
  767.     (if (or (and (overlay-get (car ovls) 'w3)
  768.              (nth 1 (overlay-get (car ovls) 'w3)))
  769.         (overlay-get (car ovls) 'w3form))
  770.         (setq tmp (cons (car ovls) tmp)))
  771.     (setq ovls (cdr ovls)))
  772.       (cond
  773.        ((nth (1- p) tmp)
  774.     (goto-char (overlay-start (nth (1- p) tmp)))
  775.     (skip-chars-forward " \t\n")
  776.     (cond
  777.      ((eq w3-echo-link 'url) (w3-view-this-url))
  778.      ((and (eq w3-echo-link 'text))
  779.       (message "%s" (buffer-substring (overlay-start (nth (1- p) tmp))
  780.                       (overlay-end (nth (1- p) tmp)))))
  781.      (t nil)))
  782.        (t
  783.     (error "No more links."))))))
  784.   
  785. (defun w3-overlays-at (pt)
  786.   ;; Return a list of just the overlays containing links/forms/images
  787.   ;; in them at position PT
  788.   (let ((done nil)
  789.     (ovls (overlays-at pt))
  790.     (rslt nil)
  791.     (dat nil))
  792.     (while ovls
  793.       (setq dat (overlay-properties (car ovls)))
  794.       (if (or (and (memq 'w3 dat)
  795.            (nth 2 (cdr (memq 'w3 dat))))
  796.           (memq 'w3form dat))
  797.       (setq rslt (cons (car ovls) rslt)))
  798.       (setq ovls (cdr ovls)))
  799.     (nreverse rslt)))
  800.  
  801. (defun w3-forward-link (p)
  802.   "Go forward 1 link.  With prefix argument, go that many links."
  803.   (interactive "p")
  804.   (setq p (or p 1))
  805.   (if (< p 0)
  806.       (w3-back-link (- p))
  807.     (if (/= p 1) (w3-forward-link (1- p)))
  808.     (cond
  809.      ((= (point-max) (next-overlay-change (point)))
  810.       (error "No more links."))
  811.      (t
  812.       (let ((save-pos (point))
  813.         (x (next-overlay-change (point)))
  814.         (y (point-max)))
  815.     (if (w3-overlays-at (point))
  816.         (progn
  817.           (goto-char (overlay-end (car (w3-overlays-at (point)))))
  818.           (setq x (point))))
  819.     (while (and (not (w3-overlays-at x)) (/= x y))
  820.       (setq x (next-overlay-change x)))
  821.     (if (= x y)
  822.         (progn
  823.           (goto-char save-pos)
  824.           (error "No more links."))
  825.       (goto-char x)
  826.       (cond
  827.        ((eq w3-echo-link 'url) (w3-view-this-url))
  828.        ((and (eq w3-echo-link 'text)
  829.          (setq x (w3-overlays-at x)))
  830.         (message "%s" (buffer-substring (overlay-start (car x))
  831.                         (overlay-end (car x)))))
  832.        (t nil))))))))
  833.  
  834. (defun w3-zone-hidden-p (start end)
  835.   "Return t iff the region from start to end is invisible."
  836.   (let ((x (overlays-at (1+ start))) y)
  837.     (while (and x (not y))
  838.       (if (overlay-get (car x) 'invisible)
  839.       (setq y t))
  840.       (setq x (cdr x)))
  841.     y))
  842.   
  843. (defun w3-unhide-zone (start end)
  844.   "Make a region from START TO END visible. (emacs19)"
  845.   (let ((x (overlays-at (1+ start))))
  846.     (while x
  847.       (if (overlay-get (car x) 'invisible)
  848.       (overlay-put (car x) 'invisible nil))
  849.       (setq x (cdr x)))))
  850.  
  851. (defun w3-hide-zone (start end)
  852.   "Make a region from START to END invisible. (emacs19)"
  853.   (overlay-put (make-overlay start end) 'invisible t))
  854.  
  855. (defun w3-extend-zone (zone new-end)
  856.   (let ((beg (overlay-start zone)))
  857.     (move-overlay zone beg new-end)))
  858.  
  859. (defun w3-add-zone (start end style data &optional highlight)
  860.   "Add highlighting (emacs19)"
  861.   (let ((ovl (make-overlay start end)))
  862.     (overlay-put ovl 'face style)
  863.     (overlay-put ovl (car data) (cdr data))
  864.     (overlay-put ovl 'rear-nonsticky t)
  865.     (overlay-put ovl 'front-sticky nil)
  866.     (cond
  867.      ((not w3-emacs19-hack-faces-p) nil) ; Don't hack faces
  868.      ((memq style '(w3-node-style w3-visited-node-style b i))
  869.       (goto-char end) (insert 4)
  870.       (goto-char start) (insert 3))
  871.      ((memq style '(h1 h2 h3 h4 h5 h6 u))
  872.       (goto-char end) (insert 2)
  873.       (goto-char start) (insert 1)))
  874.     (if (and (eq (car data) 'w3) (nth 1 data))
  875.     (overlay-put ovl 'w3-ident (nth 1 data)))
  876.     (cond
  877.      ((and (eq (car data) 'w3) highlight)
  878.       (overlay-put ovl 'mouse-face 'highlight))
  879.      ((eq (car data) 'w3form)
  880.       (overlay-put ovl 'mouse-face 'region))
  881.      ((eq (car data) 'w3graphic)
  882.       (overlay-put ovl 'mouse-face 'secondary-selection))
  883.      )
  884.     ovl))
  885.  
  886. (defun w3-follow-inlined-image ()
  887.   "Follow an inlined image, regardless of whether it is a hyperlink or not."
  888.   (interactive)
  889.   (let ((ovls (overlays-at (point))) done)
  890.     (while (and ovls (not done))
  891.       (if (not (overlay-get (car ovls) 'w3graphic))
  892.       nil
  893.     (url-maybe-relative (nth 0 (overlay-get (car ovls) 'w3graphic)))
  894.     (setq done t))
  895.       (setq ovls (cdr ovls)))
  896.     (if (not done) (error "No inlined image at point."))))
  897.  
  898.  
  899. (provide 'w3-emacs19)
  900. (provide 'w3-e19)
  901.